home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / consl / unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  4.5 KB  |  183 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  6.   Console, ExtCtrls;
  7.  
  8. type
  9.   TForm1 = class(TForm)
  10.     Colors: TButton;
  11.     Fonts: TButton;
  12.     Size: TEdit;
  13.     LazyWrite: TCheckBox;
  14.     Clear: TButton;
  15.     P1: TPanel;
  16.     L1: TLabel;
  17.     Terminal1: TColorConsole;
  18.     procedure ShowTestPattern(Sender: TObject);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure ClearClick(Sender: TObject);
  21.     procedure ColorsClick(Sender: TObject);
  22.     procedure LazyWriteClick(Sender: TObject);
  23.     procedure SizeLostFocus(Sender: TObject);
  24.   private
  25.     { Private declarations }
  26.   public
  27.     { Public declarations }
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.  
  33. implementation
  34.  
  35. {$R *.DFM}
  36.  
  37. procedure TForm1.ShowTestPattern(Sender: TObject);
  38. var
  39.   T: TTextMetric;
  40.   X: Integer;
  41.   Norm, Test: TFont;
  42. begin
  43.   Terminal1.Font.Name := 'Courier New';
  44.   Norm := TFont.Create;
  45.   Norm.Assign(Terminal1.Font);
  46.   Test := TFont.Create;
  47.   Cursor := crHourGlass;
  48.   try
  49.     Terminal1.Font.BkColor := clBlue;
  50.     writeln('Name':22,'Ave':5,'Max':5,'Ovr':5);
  51.     for X := 0 to Screen.Fonts.Count - 1 do
  52.     with Terminal1 do
  53.     try
  54.       Font.Assign(Norm);
  55.       Font.Name := Screen.Fonts[x];   { Exceptions }
  56.       Test.Assign(Font);
  57.       Canvas.Font := Test;
  58.       GetTextMetrics(Canvas.Handle, T);
  59.       Font.Assign(Norm);
  60.       Font.BkColor := clBlue;
  61.       write(Screen.Fonts[x]:22,T.tmAveCharWidth:5,
  62.             T.tmMaxCharWidth:5,T.tmOverhang:5);
  63.       Font.Assign(Test);
  64.       Font.BkColor := clBlack;
  65.       write('This is some sample text. T');
  66.       Font.Assign(Norm);
  67.       Font.BkColor := clBlue;
  68.       writeln('T');
  69.  
  70.       Test.Style := [fsBold];
  71.       Canvas.Font := Test;
  72.       GetTextMetrics(Canvas.Handle, T);
  73.       write(Screen.Fonts[x]:22,T.tmAveCharWidth:5,
  74.             T.tmMaxCharWidth:5,T.tmOverhang:5);
  75.       Font.Assign(Test);
  76.       Font.BkColor := clBlack;
  77.       write('This is some sample text. T');
  78.       Font.Assign(Norm);
  79.       Font.BkColor := clBlue;
  80.       writeln('T');
  81.  
  82.       Test.Style := [fsItalic];
  83.       Canvas.Font := Test;
  84.       GetTextMetrics(Canvas.Handle, T);
  85.       write(Screen.Fonts[x]:22,T.tmAveCharWidth:5,
  86.             T.tmMaxCharWidth:5,T.tmOverhang:5);
  87.       Font.Assign(Test);
  88.       Font.BkColor := clBlack;
  89.       write('This is some sample text. T');
  90.       Font.Assign(Norm);
  91.       Font.BkColor := clBlue;
  92.       writeln('T');
  93.     except
  94.       on EInvalidFont do ;  { nothing }
  95.     end;
  96.   finally
  97.     Terminal1.Font.Assign(Norm);
  98.     Terminal1.Font.BkColor := clBlue;
  99.     Norm.Free;
  100.     Test.Free;
  101.     Cursor := crDefault;
  102.   end;
  103. end;
  104.  
  105. procedure TForm1.FormCreate(Sender: TObject);
  106. var
  107.   P: Pointer;
  108. begin
  109.   Size.Text := IntToStr(Terminal1.Font.Size);
  110.   LazyWrite.Checked := coLazyWrite in Terminal1.Options;
  111.   writeln('TColorTerminal demo');
  112. end;
  113.  
  114. procedure TForm1.ClearClick(Sender: TObject);
  115. begin
  116.   Terminal1.ClrScr;
  117. end;
  118.  
  119. procedure TForm1.ColorsClick(Sender: TObject);
  120. const
  121.   Colors: array [1..8] of TColor =
  122.     (clBlack, clBlue, clGreen, clRed, clYellow, clAqua, clFuchsia, clWhite);
  123.   ColorNames: array [1..8] of String[7] =
  124.     ('Black','Blue','Green','Red','Yellow','Aqua','Fuchsia','White');
  125. var
  126.   X, Y: Integer;
  127. begin
  128.   with Terminal1 do
  129.   try
  130.     Cursor := crHourGlass;
  131.     Font.Name := 'Courier New';
  132.     Font.Color := clYellow;
  133.     Font.BkColor := clBlue;
  134.     writeln('Courier New');
  135.     write('This is a sample of ');
  136.     Font.Color := clRed;
  137.     write('multi');
  138.     Font.Color := clLime;
  139.     write('-');
  140.     Font.Color := clAqua;
  141.     write('color');
  142.     Font.BkColor := clFuchsia;
  143.     writeln(' text.');
  144.     for X := 1 to 8 do
  145.     begin
  146.       Font.Color := Colors[x];
  147.       for Y := 1 to 8 do
  148.       begin
  149.         Font.BkColor := Colors[Y];
  150.         if Odd(X+Y) then
  151.         begin
  152.           Font.Style := [fsBold];
  153.           write('Bold ');
  154.         end;
  155.         write(ColorNames[X],' on ',ColorNames[Y]);
  156.         Font.Style := [];
  157.         if Y = 4 then Writeln;
  158.       end;
  159.       writeln;
  160.     end;
  161.     Font.BkColor := clBlue;
  162.     Font.Color := clYellow;
  163.     Font.Style := [];
  164.   finally
  165.     Cursor := crDefault;
  166.   end;
  167. end;
  168.  
  169. procedure TForm1.LazyWriteClick(Sender: TObject);
  170. begin
  171.   if LazyWrite.Checked then
  172.     Terminal1.Options := Terminal1.Options + [coLazyWrite]
  173.   else
  174.     Terminal1.Options := Terminal1.Options - [coLazyWrite];
  175. end;
  176.  
  177. procedure TForm1.SizeLostFocus(Sender: TObject);
  178. begin
  179.   Terminal1.Font.Size := StrToInt(Size.Text);
  180. end;
  181.  
  182. end.
  183.